home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Wayzata's Best of Shareware PC/Windows 1
/
Wayzata's Best of Shareware for PC-Windows - Release 1 - Wayzata Technology (1993).iso
/
mac
/
DOS
/
PRINTERS
/
PSCRIPT
/
PSCRIPT.SC
next >
Wrap
Text File
|
1992-05-20
|
10KB
|
302 lines
;╔════════════════════════╤════════════════════════╤═══════════════════════════╗
;║ Script Name: Pscript │ Creation Date:10/04/92 │ Author: C. Campbell ║
;║ │ Last Revision:20/05/92 │ Revised By: C. Campbell ║
;╟────────────────────────┴────────────────────────┴───────────────────────────╢
;║ Description: Prints a script or selected list ║
;║ ║
;║ ║
;║ ║
;║ ║
;╟─────────────────────────────────────────────────────────────────────────────╢
;║ Called By: NONE ║
;╟─────────────────────────────────────────────────────────────────────────────╢
;║ Libraries: NONE ║
;╟──────────┬─────────┬─────────┬──────────┬───────────────────┬───────────────╢
;║ Tables │ Forms │ Reports │ Scripts │ Procedures │ External Pgms ║
;╟──────────┼─────────┼─────────┼──────────┼───────────────────┼───────────────╢
;║Pstbl │ │ │ │ │see Pscript.txt║
;║ │ │ │ │ │ ║
;║ │ │ │ │ │ ║
;║ │ │ │ │ │ ║
;╟──────────┴─────────┴─────────┴──────────┴───────────────────┴───────────────╢
;║Notes: NONE ║
;║ ║
;╚═════════════════════════════════════════════════════════════════════════════╝
PROC ShowMsg(inmsg,ca,clrscrn,slp)
CANVAS ON
IF clrscrn = "Y" THEN
CLEAR
ENDIF
MESSAGE inmsg
IF ca = "OFF" THEN
CANVAS OFF
ENDIF
SLEEP slp
ENDPROC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PrinterOn ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PROC PrinterOn()
PRIVATE i,kp
FOR i FROM 1 TO 4
ShowMsg("Checking to see if the printer is ready, Please wait!",
"Off","N",0)
IF PRINTERSTATUS() THEN
CLEAR
RETURN True
ELSE
IF i = 4 THEN
RETURN False
ELSE
BEEP SLEEP 100 BEEP SLEEP 100 BEEP
ShowMsg("Printer not on, press any key after turning printer on",
"Off","N",0)
kp = GETCHAR()
ENDIF
ENDIF
ENDFOR
ENDPROC
;;;;;;;;;;;;;;;;;;;;;;;;;;; MenuScreen ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PROC MenuScreen()
CANVAS OFF
CLEAR
@ 0,0
TEXT
Dir Select Exit
Change directories
╔══════════════════════════════════════════════════════════════════════════════╗
║ ░░░░░░░░░░░░░ S C R I P T P R I N T I N G U T I L I T Y ░░░░░░░░░░░░░░ ║
╟────────────────╥─────────────────────────────────────────────────────────────╢
║ Dir ║ Change directories ║
╠════════════════╬═════════════════════════════════════════════════════════════╣
║ Select ║ Select and print scripts ║
╠════════════════╬═════════════════════════════════════════════════════════════╣
║ Exit ║ Leave the Script Printing Routine ║
╚════════════════╩═════════════════════════════════════════════════════════════╝
ENDTEXT
PAINTCANVAS ATTRIBUTE 78 4,15,4,63
PAINTCANVAS ATTRIBUTE SYSCOLOR(0) 0,0,1,79
PAINTCANVAS ATTRIBUTE SYSCOLOR(2) 0,0,0,3
CANVAS ON
ENDPROC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; GetList ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PROC GetList()
IF NOT ISTABLE("Pstbl") THEN ; need Pstbl for list of scripts
COPY "\\Pdox\\Pstbl" "Pstbl" ; assume Pstbl is in \Pdox, change if
ENDIF ; needed
IF NOT ISEMPTY("Pstbl") THEN
CANVAS ON
SHOWMENU
"New" : "Build new list",
"Old" : "Use existing list"
TO choice
CANVAS OFF
IF choice = "Old" THEN
RETURN
ENDIF
ENDIF
EMPTY "Pstbl"
{Tools} {Info} {Inventory} {Scripts} SELECT dirname
Query
List |Name |
| _scrs,NOT Pscript | ; change if not using SHARE
Pstbl | Script Name |
INSERT | _scrs |
Endquery
DO_IT!
CLEARALL
ENDPROC
;;;;;;;;;;;;;;;;;;;;;;;;;;;; SELECTSCRIPT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PROC SelectScript()
EDIT "Pstbl"
FORMKEY
CLEAR
CANVAS ON
WHILE True
WAIT RECORD
PROMPT "Select scripts to print [F2]-Save [Esc]-Cancel ",
"[F6]-Select Toggle [Alt][F6]-Select All Scripts"
UNTIL "Up","Down","Enter","CHECK","CHECKPLUS","F2","ESC",
"DOS","DOSBIG","ZOOM","ZOOMNEXT","INS","DEL"
SWITCH
CASE retval = "Enter" OR retval = "Down" :
IF NOT ATLAST() THEN
DOWN
ELSE
BEEP
ENDIF
LOOP
CASE retval = "Up" :
IF NOT ATFIRST() THEN
UP
ELSE
BEEP
ENDIF
LOOP
CASE retval = "CHECK" :
IF ISBLANK([]) THEN
"√"
ELSE
CTRLBACKSPACE
ENDIF
LOOP
CASE retval = "CHECKPLUS" :
SCAN
"√"
ENDSCAN
LOOP
CASE retval = "F2" :
QUITLOOP
CASE retval = "ESC" :
SHOWMENU
"No" : "Return to script selection, do not cancel",
"Yes" : "Cancel script selection, return to Main Menu"
TO cancelchoice
IF cancelchoice = "Yes" THEN
CANVAS OFF
CLEAR
MESSAGE "No scripts selected, print list creation halted!"
CANVAS ON
CANCELEDIT
RETURN False
ENDIF
OTHERWISE : BEEP
ENDSWITCH
ENDWHILE
CLEAR
@20,20 STYLE ATTRIBUTE 30 ?? FORMAT("w40,ac","Working... Please Wait")
DO_IT!
RETURN True
ENDPROC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REMOVENOTSELECTED ;;;;;;;;;;;;;;;;;;;;;;;;;
PROC RemoveNotSelected()
Query
Pstbl | Selection Indicator |
DELETE | BLANK |
Endquery
DO_IT!
MOVETO 1
CLEARIMAGE ; Remove the query image
DELETE "Deleted" ; Remove Deleted table
ENDPROC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; GETSCRIPTNAMES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PROC GetScriptNames()
CANVAS ON
MESSAGE "Getting list of scripts in current directory, Please wait!"
CANVAS OFF
GetList()
retprocval = SelectScript()
CLEARALL
IF NOT retprocval THEN
RETURN false
ENDIF
RemoveNotSelected()
IF ISEMPTY("Pstbl") THEN
CANVAS OFF
MESSAGE "No scripts selected, print list creation halted!"
@ 24, 0 ?? " Press any key to continue "
CANVAS ON
kp = GETCHAR()
RETURN False
ENDIF
CANVAS OFF
CLEARALL ; change to remove query image
RETURN True
ENDPROC
;;;;;;;;;;;;;;;;;;;;; CHANGEDIR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PROC ChangeDir()
PRIVATE newdir
CURSOR NORMAL
@ 0,0 ?? "Current Directory: " + dirname
@ 1,0 ?? "Enter new directory name ([Esc] to cancel): "
ACCEPT "A50" TO newdir
IF NOT retval OR ISBLANK(newdir) THEN
RETURN
ENDIF
WHILE DIREXISTS(newdir) = 0
MESSAGE " Directory does not exist "
@ 0,0 CLEAR EOL
?? "Enter directory name: "
ACCEPT "A50" TO newdir
IF NOT retval OR ISBLANK(newdir) THEN
RETURN
ENDIF
ENDWHILE
SETDIR newdir
CURSOR OFF
dirname = newdir
ENDPROC
;;;;;;;;;;;;;;;;;;;;;;;;; PRT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PROC Prt()
ShowMsg(" Printing your list, please wait.","OFF","N",0)
IF ISFILE("Scrprint.bat") THEN
RUN NOREFRESH "Del scrprint.bat"
ENDIF
Query ; change "laserlst" to suit your site, eg TYPE
; or equivalent
Pstbl | Script Name | Selection Indicator |
| _a | calc "laserlst " + _a + ".sc > NUL" AS out |
Endquery
DO_IT!
Menu {Tools} {ExportImport} {Export} {Ascii} {Text} {answer} {scrprint.bat}
RUN NOREFRESH "Scrprint.bat"
CLEARALL
MESSAGE "Script printing complete...."
@24,0 ?? " Press any key to continue"
CANVAS ON
kp = GETCHAR()
ENDPROC
;;;;;;;;;;;;;;;;;;;;; M A I N ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ECHO OFF
CURSOR OFF
CLEAR
MESSAGE "Loading, Please wait!"
CANVAS OFF
CLEARALL
RESET
dirname = DIRECTORY()
SETDIR dirname ; change directory to current
; directory to clear temporary
; tables
WHILE True
MENUSCREEN()
SHOWMENU
"Dir" : "Change directory",
"Select" : "Select and print scripts",
"Exit" : "Leave the utility"
TO choice
IF choice = "Esc" OR choice = "Exit" THEN
SHOWMENU
"No" : "Return to the Script Printer",
"Yes" : "Leave the program"
TO yn
IF yn = "Yes" THEN
QUIT
ELSE
LOOP
ENDIF
ELSE
IF choice = "Dir" THEN
ChangeDir()
ELSE
retprocval = GetScriptNames()
IF retprocval THEN
Prt()
; Printem()
ENDIF
ENDIF
ENDIF
ENDWHILE